home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Directories.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-12-01  |  8.8 KB  |  234 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 1 Dec 95
  5. ParcElems
  6. Alloc
  7. Syntax10b.Scn.Fnt
  8. Syntax8i.Scn.Fnt
  9. Syntax10i.Scn.Fnt
  10. FoldElems
  11. Syntax10.Scn.Fnt
  12. "APPL"
  13. MODULE Directories;    (* HM 
  14. IMPORT Sys, Strings, SYSTEM;
  15. CONST
  16.     noErr* = 0;    (**no error*)
  17.     badName* = 1;    (**bad file or directory name*)
  18.     mediumFull* = 2;    (**disk or directory full*)
  19.     mediumLocked* = 3;    (**hardware or software lock*)
  20.     dirInUse* = 4;    (**directory in use or not empty*)
  21.     notADir* = 5;    (**name does not specify a directory*)
  22.     alreadyExists* = 6;    (**directory already exists*)
  23.     otherError* = 7;    (**other OS-specific error*)
  24.     delete* = 0; insert* = 1; change* = 2;    (** notify operations **)
  25.     delimiter* = ":";    (** delimiter in path names **)
  26.     dirFullErr = -33; dskFullErr = -34; nsvErr = -35; bdNamErr = -37; fnfErr = -43;
  27.     wPrErr = -44; fLckdErr = -45; vLckdErr = -46; fBsyErr = -47; dupFNErr = -48; dirNFErr = -120;
  28.     Directory* = POINTER TO DirectoryDesc;
  29.     DirectoryDesc* = RECORD
  30.         path*: ARRAY 128 OF CHAR;
  31.         spec*: Sys.FSSpec;
  32.         dirID*: LONGINT
  33.     END;
  34.     FileProc* = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
  35.     PathProc* = PROCEDURE (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
  36.     CInfoPBDirPtr = POINTER TO CInfoPBDirRec;
  37.     CInfoPBDirRec = RECORD (Sys.CInfoPBRec)
  38.         ioDrUsrWds: Sys.DInfo;    (* information used by the Finder *)
  39.         ioDrDirID: LONGINT;     (* directory ID *)
  40.         ioDrNmFls: INTEGER;     (* number of files in directory *)
  41.         filler3: ARRAY 9 OF INTEGER;
  42.         ioDrCrDat: LONGINT;     (* date and time of creation *)
  43.         ioDrMdDat: LONGINT;     (* date and time of last modification *)
  44.         ioDrBkDat: LONGINT;     (* date and time of last backup *)
  45.         ioDrFndrInfo: Sys.DXInfo;     (* additional Finder information *)
  46.         ioDrParID: LONGINT     (* directory's parent directory ID *)
  47.     END;
  48.     SearchPath = POINTER TO SearchPathDesc;
  49.     SearchPathDesc = RECORD [Sys.align68K]
  50.         vRefNum: INTEGER;
  51.         dirID: LONGINT;
  52.         next: SearchPath;
  53.     END;
  54.     Notifier* = PROCEDURE (op: INTEGER; path, name: ARRAY OF CHAR);
  55.     (* "paths" must be the first variable in the declaration list. Loader installs path list here *)
  56.     paths: LONGINT;
  57.     res*: INTEGER;
  58.     notify*: Notifier;
  59.     startupPath: ARRAY 128 OF CHAR;    (*path containing the Oberon application*)
  60. PROCEDURE^ Current* (): Directory;
  61. PROCEDURE StrToArr (VAR str, arr: ARRAY OF CHAR);
  62.     VAR i: INTEGER;
  63. BEGIN
  64.     FOR i := 1 TO ORD(str[0]) DO arr[i-1] := str[i] END;
  65.     arr[i-1] := 0X
  66. END StrToArr;
  67. PROCEDURE ArrToStr (VAR arr, str: ARRAY OF CHAR);
  68.     VAR i: INTEGER;
  69. BEGIN
  70.     i := 0; WHILE arr[i] # 0X DO str[i+1] := arr[i]; INC(i) END;
  71.     str[0] := CHR(i)
  72. END ArrToStr;
  73. PROCEDURE GetPath (v: INTEGER; d: LONGINT; VAR path: ARRAY OF CHAR);
  74.     VAR s: Sys.Str255; res, i, j: INTEGER; spec: Sys.FSSpec; buf: ARRAY 128 OF CHAR;
  75. BEGIN
  76.     j := 128; s := "";
  77.     REPEAT
  78.         DEC(j); buf[j] := delimiter;
  79.         res := Sys.FSMakeFSSpec(v, d, s, spec);
  80.         FOR i := ORD(spec.name[0]) TO 1 BY -1 DO DEC(j); buf[j] := spec.name[i] END;
  81.         d := spec.parID
  82.     UNTIL d = 1;
  83.     i := 0; WHILE j < 127 DO path[i] := buf[j]; INC(i); INC(j) END;
  84.     path[i] := 0X
  85. END GetPath;
  86. PROCEDURE GetParentPath (VAR path: ARRAY OF CHAR);
  87.     VAR i, j: INTEGER;
  88. BEGIN
  89.     i := 0; j := 0;
  90.     WHILE path[i] # 0X DO
  91.         IF path[i] = delimiter THEN j := i END;
  92.         INC(i)
  93.     END;
  94.     path[j] := 0X
  95. END GetParentPath;
  96. PROCEDURE Extend (VAR s, path: ARRAY OF CHAR);
  97.     VAR d: Directory;
  98. BEGIN
  99.     COPY(s, path);
  100.     IF path[0] = delimiter THEN
  101.         d := Current(); Strings.Insert(d.path, 0, path)
  102.     ELSIF path[0] = "$" THEN
  103.         Strings.Delete(path, 0, 1); Strings.Insert(delimiter, 0, path); Strings.Insert(startupPath, 0, path)
  104. END Extend;
  105. PROCEDURE Init;
  106.     VAR d: Directory;
  107. BEGIN
  108.     d := Current(); COPY(d.path, startupPath)
  109. END Init;
  110. PROCEDURE Call (errCode: INTEGER);
  111. BEGIN
  112.     CASE errCode OF
  113.         noErr: res := noErr
  114.     |   fnfErr, nsvErr, bdNamErr, dirNFErr: res := badName
  115.     |   dupFNErr: res := alreadyExists
  116.     |   dirFullErr, dskFullErr: res := mediumFull
  117.     |   wPrErr, fLckdErr, vLckdErr: res := mediumLocked
  118.     |   fBsyErr: res := dirInUse
  119.     ELSE res := otherError
  120. END Call;
  121. PROCEDURE Current* (): Directory;
  122.     VAR d: Directory; s: Sys.Str255; vRefNum: INTEGER;
  123. BEGIN
  124.     NEW(d); s := "";
  125.     Call(Sys.HGetVol(SYSTEM.ADR(s), vRefNum, d.dirID)); ASSERT(res = 0);
  126.     GetPath(vRefNum, d.dirID, d.path);
  127.     ArrToStr(d.path, s);
  128.     Call(Sys.FSMakeFSSpec(0, 0, s, d.spec));
  129.     RETURN d
  130. END Current;
  131. PROCEDURE This* (path: ARRAY OF CHAR): Directory;
  132.     VAR par: CInfoPBDirRec; s: Sys.Str255; d: Directory;
  133. BEGIN
  134.     NEW(d); Extend(path, d.path);
  135.     ArrToStr(d.path, s);
  136.     Call(Sys.FSMakeFSSpec(0, 0, s, d.spec));
  137.     IF res = noErr THEN
  138.         par.ioCompletion := 0; par.ioNamePtr := SYSTEM.ADR(s);
  139.         par.ioVRefNum := d.spec.vRefNum; par.ioFDirIndex := 0; par.ioDrDirID := d.spec.parID;
  140.         Call(Sys.PBGetCatInfo(SYSTEM.VAL (Sys.CInfoPBPtr, SYSTEM.ADR(par))));
  141.         IF ODD(par.ioFlAttrib DIV 16) THEN d.dirID := par.ioDrDirID
  142.         ELSE res := notADir; d := NIL
  143.         END
  144.     ELSE d := NIL
  145.     END;
  146.     RETURN d
  147. END This;
  148. PROCEDURE Startup* (): Directory;
  149. BEGIN
  150.     RETURN This(startupPath)
  151. END Startup;
  152. PROCEDURE Change* (path: ARRAY OF CHAR);
  153.     VAR s, path0: Sys.Str255;
  154. BEGIN
  155.     Extend(path, path0); ArrToStr(path0, s);
  156.     Call(Sys.HSetVol(SYSTEM.ADR(s), 0, 0));
  157.     IF res = noErr THEN notify (change, "", "") END
  158. END Change;
  159. PROCEDURE Create* (path: ARRAY OF CHAR);
  160.     VAR s, path0: Sys.Str255; name: ARRAY 128 OF CHAR; spec: Sys.FSSpec; dirID: LONGINT;
  161. BEGIN
  162.     Extend(path, path0); ArrToStr(path0, s);
  163.     Call(Sys.FSMakeFSSpec(0, 0, s, spec));
  164.     IF (res = noErr) OR (res = badName) THEN
  165.         Call(Sys.FSpDirCreate(spec, Sys.smSystemScript, dirID));
  166.         IF res = noErr THEN
  167.             GetParentPath(path0); StrToArr(spec.name, name); notify(insert, path0, name)
  168.         END
  169. END Create;
  170. PROCEDURE Delete* (path: ARRAY OF CHAR);
  171.     VAR s, path0: Sys.Str255; spec: Sys.FSSpec; name: ARRAY 128 OF CHAR;
  172. BEGIN
  173.     Extend(path, path0); ArrToStr(path0, s);
  174.     Call(Sys.FSMakeFSSpec(0, 0, s, spec));
  175.     IF res = noErr THEN Call(Sys.FSpDelete(spec)) END;
  176.     IF res = noErr THEN GetParentPath(path0); StrToArr(spec.name, name); notify(delete, path0, name) END
  177. END Delete;
  178. PROCEDURE Rename* (oldPath, newPath: ARRAY OF CHAR);
  179.     VAR s, old, new: Sys.Str255; oldSpec, newSpec, spec: Sys.FSSpec; i: INTEGER;
  180.         oldName, newName: ARRAY 32 OF CHAR;
  181.         result: INTEGER;
  182. BEGIN
  183.     Extend(oldPath, old); ArrToStr(old, s); GetParentPath(old); Call(Sys.FSMakeFSSpec(0, 0, s, oldSpec));
  184.     IF res = noErr THEN
  185.         Extend(newPath, new); ArrToStr(new, s); GetParentPath(new); Call(Sys.FSMakeFSSpec(0, 0, s, newSpec));
  186.         IF (res = noErr) OR (res = badName) THEN
  187.             IF oldSpec.parID = newSpec.parID THEN
  188.                 FOR i := 0 TO ORD(newSpec.name[0]) DO s[i] := newSpec.name[i] END;
  189.                 Call(Sys.FSpRename(oldSpec, s))
  190.             ELSE
  191.                 ArrToStr(new, s); Call(Sys.FSMakeFSSpec(0, 0, s, spec));
  192.                 Call(Sys.FSpCatMove(oldSpec, spec))
  193.             END;
  194.             StrToArr(oldSpec.name, oldName); StrToArr(newSpec.name, newName);
  195.             IF res = noErr THEN result := res;  notify(delete, old, oldName); notify(insert, new, newName); res := result END
  196.         END
  197. END Rename;
  198. PROCEDURE Enumerate* (d: Directory; proc: FileProc);
  199.     VAR par: Sys.CInfoPBFileRec; i: INTEGER; s: Sys.Str255; name: ARRAY 128 OF CHAR; continue: BOOLEAN; res: INTEGER;
  200. BEGIN
  201.     continue := TRUE;
  202.     par.ioCompletion := 0; par.ioVRefNum := d.spec.vRefNum;
  203.     i := 1;
  204.     LOOP
  205.         par.ioDirID := d.dirID; par.ioFDirIndex := i; par.ioNamePtr := SYSTEM.ADR(s);
  206.         res := Sys.PBGetCatInfo(SYSTEM.VAL(Sys.CInfoPBFilePtr, SYSTEM.ADR(par)));
  207.         IF res = noErr THEN
  208.             IF par.ioFlFndrInfo.fdType # 
  209. 4150504CH
  210.  THEN
  211.                 StrToArr(s, name);
  212.                 proc(d, name, ODD(par.ioFlAttrib DIV 16), continue);
  213.                 IF ~continue THEN RETURN END
  214.             END;
  215.             INC(i)
  216.         ELSIF res = fnfErr THEN RETURN
  217.         ELSE HALT(20)
  218.         END
  219. END Enumerate;
  220. PROCEDURE EnumeratePaths* (proc: PathProc);
  221.     VAR path: ARRAY 256 OF CHAR; continue: BOOLEAN; p: SearchPath;
  222. BEGIN
  223.     continue := TRUE; p := SYSTEM.VAL (SearchPath, paths);
  224.     WHILE continue & (p # NIL) DO
  225.         GetPath (p.vRefNum, p.dirID, path); proc(path, continue);
  226.         p := p.next
  227. END EnumeratePaths;
  228. PROCEDURE NoNotify (op: INTEGER; path, name: ARRAY OF CHAR);    
  229. END NoNotify;
  230. BEGIN
  231.     notify := NoNotify;
  232.     Init
  233. END Directories.
  234.